VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Line"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2001                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idConnect = 11
Const idConFirst = 12
Const idConSecond = 13
Const idVerFirst = 14
Const idVerSecond = 15
Const idArrowFirst = 16
Const idArrowSecond = 17

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 7
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0
Const formCaption = "Connector"

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Connector"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FE-6A20-11d0-A115-00A024158DAE}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "OwnCon"
    Types(0) = typeString
    IDs(0) = idConnect
    Defaults(0) = "CONNECT"
    
    Names(1) = "FirstConID"
    Types(1) = typeLong
    IDs(1) = idConFirst
    Defaults(1) = -1
    
    Names(2) = "SecondConID"
    Types(2) = typeLong
    IDs(2) = idConSecond
    Defaults(2) = -1
    
    Names(3) = "FirstVerCon"
    Types(3) = typeLong
    IDs(3) = idVerFirst
    Defaults(3) = -1
    
    Names(4) = "SecondVerCon"
    Types(4) = typeLong
    IDs(4) = idVerSecond
    Defaults(4) = -1
    
    Names(5) = "FirstArrow"
    Types(5) = typeInteger
    IDs(5) = idArrowFirst
    Defaults(5) = 0
    
    Names(6) = "SecondArrow"
    Types(6) = typeInteger
    IDs(6) = idArrowSecond
    Defaults(6) = 0

  
  GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
'    Load Form1
'    Names(0) = Form1.Caption
'    Unload Form1
    Names(0) = formCaption
    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
Dim Arrow1%
Dim Arrow2%

        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With Form1
                'Need On Error statement for the case where you have
                'conn Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                ' value from the TextBox to the Graphic
                'Get the value as a double-precision number
                'Make sure it's between 0 and 100
                'Set the roundness property value in the Graphic
                
                Arrow1 = .ArrowFirst.Value
                Graphic.Properties("FirstArrow") = Arrow1
                
                Arrow2 = .ArrowSecond.Value
                Graphic.Properties("SecondArrow") = Arrow2
                
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load Form1
            With Form1
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                ' value from the Graphic to the TextBox
                'Get the property value from the Graphic
                'Set the TextBox control's text
                Arrow1 = Graphic.Properties("FirstArrow")
                .ArrowFirst.Value = Arrow1
                
                 Arrow2 = Graphic.Properties("SecondArrow")
                .ArrowSecond.Value = Arrow2
              
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False

End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload Form1
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
     With Form1
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
   
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    
    Wizard = False
    
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis1 As Graphic
    Set grfThis1 = grfThis
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable,Calculated
    'First Vertex is "lower left" corner
    grfThis1.Vertices.Add 1, 1, 0#, False, False, True, True, True, True
    'Second Vertex is "upper right" corner
    grfThis1.Vertices.Add 5, 5, 0#, False, False, True, True, True, True
    grfThis1.Vertices.Add (1 + 5) / 2, (1 + 5) / 2, 0#, False, False, True, True, True, True
   OnNewGraphic = True
   Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

Private Function LinkAtVertex(ByVal grfThis1 As Object, ByVal ivLink As Long, ByRef grfLink As Object, ivBase As Long) As Boolean
   'Default return value
Dim grfThis As Graphic
    Set grfThis = grfThis1
    LinkAtVertex = False
    Dim Answer As Graphic
    On Error GoTo Errors
Dim i As Long, xV#, yV#, xLink#, yLink#, j As Long, nVLink As Long
Dim TypeCon As String
For i = 0 To 0
    Set Answer = grfThis.GetSubjectLink(ivLink, i)
    Set grfLink = Answer
    TypeCon = " "
On Error Resume Next
   TypeCon = grfLink.Properties("OwnCon")
    If TypeCon <> "CONNECT" Then
        nVLink = grfLink.Vertices.Count - 1
        For j = 0 To nVLink
            xV = grfLink.Vertices.Item(j).x
            yV = grfLink.Vertices.Item(j).Y
            xLink = grfThis.Vertices.Item(ivLink).x
            yLink = grfThis.Vertices.Item(ivLink).Y
            If Abs(xV - xLink) < 0.000001 And Abs(yV - yLink) < 0.000001 Then
                ivBase = j
                If ivLink = 0 Then
                    grfThis.Properties("FirstVerCon") = ivBase
                Else
                    grfThis.Properties("SecondVerCon") = ivBase
                End If
            End If
        Next j
    End If
Next i
    LinkAtVertex = True

    Exit Function

Errors:
    LinkAtVertex = True
End Function



'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
Dim grfLink0 As Graphic
Dim grfLink1 As Graphic
Dim Arrow1%
Dim Arrow2%
Dim grfThis1 As Graphic
        Set grfThis1 = grfThis
        'Setup error handler
        On Error GoTo Failed
        'Set up lock (prevent recursion)
        Dim LockCount&
        If grfThis1.Vertices.Count = 0 Then
                Exit Function
        End If
        LockCount& = grfThis1.RegenLock

        'Setup error handler (make sure lock is removed)
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis1.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean

            Arrow1 = grfThis1.Properties("FirstArrow")
            Arrow2 = grfThis1.Properties("SecondArrow")

            'Add child Graphics
            Dim grfChild As Graphic
            Dim x0#, y0#, x1#, y1#, x2#, y2#
    
  Dim linkBool As Boolean
  Dim ivLink0 As Long, ivLink1 As Long
  ivLink0 = -1
  ivLink1 = -1
  linkBool = LinkAtVertex(grfThis1, 0, grfLink0, ivLink0)
  linkBool = LinkAtVertex(grfThis1, 1, grfLink1, ivLink1)
            With grfThis1.Vertices
               x0 = .Item(0).x
               y0 = .Item(0).Y
               x1 = .Item(1).x
               y1 = .Item(1).Y
            End With
            
Dim x00#, y00#, x11#, y11#, del#
 Dim Ver As Vertex
'#########################################################################
'#########################################################################
            With grfThis1.Vertices
               .Item(2).Selectable = True
               .Item(2).Snappable = True
               .Item(2).Linkable = True
               .Item(2).Editable = True
               
               x2 = .Item(2).x
               y2 = .Item(2).Y
               .Item(2).x = (x0 + x1) / 2
            End With
            x00 = x0
            y00 = y2
            x11 = x1
            y11 = y2
            Set grfChild = grfThis1.Graphics.Add(11)
            With grfChild.Vertices
                .Add x0, y0, 0
                .Add x0, y2, 0
                .Add x1, y2, 0
                .Add x1, y1, 0
            End With
            grfChild.Cosmetic = True
                
'#########################################################################
'#########################################################################
' --------------------------------------------------------------------------
Dim L#, sina#, cosa#, xx1#, yy1#, xx2#, yy2#, xx#, yy#
Dim lstr#, hstr#
            lstr = 0.2
            hstr = 0.06
        If Arrow1 = 1 Then
            If Abs(x0 - x00) < 0.00001 And Abs(y0 - y00) < 0.00001 Then
                x00 = x1
                y00 = y1
            End If
            L = Sqr((x0 - x00) * (x0 - x00) + (y0 - y00) * (y0 - y00))
            sina = (y00 - y0) / L
            cosa = (x00 - x0) / L
            xx = x0 - lstr / L * (x0 - x00)
            yy = y0 - lstr / L * (y0 - y00)
            xx1 = xx + hstr * sina
            yy1 = yy - hstr * cosa
            xx2 = xx - hstr * sina
            yy2 = yy + hstr * cosa
            Set grfChild = grfThis1.Graphics.Add(11)
                grfChild.Cosmetic = True
                grfChild.Vertices.Add x0, y0, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx1, yy1, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx2, yy2, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add x0, y0, 0#, True, False, False, False, False, False
                grfChild.Closed = True
                grfChild.BrushStyle = "Solid"
                grfChild.Properties.Item("BrushColor").Value = RGB(0, 0, 0)
        End If
        
        If Arrow2 = 1 Then
            If Abs(x1 - x11) < 0.00001 And Abs(y1 - y11) < 0.00001 Then
                x11 = x0
                y11 = y0
            End If
            L = Sqr((x1 - x11) * (x1 - x11) + (y1 - y11) * (y1 - y11))
            sina = (y11 - y1) / L
            cosa = (x11 - x1) / L
            xx = x1 - lstr / L * (x1 - x11)
            yy = y1 - lstr / L * (y1 - y11)
            xx1 = xx + hstr * sina
            yy1 = yy - hstr * cosa
            xx2 = xx - hstr * sina
            yy2 = yy + hstr * cosa
            Set grfChild = grfThis1.Graphics.Add(11)
                grfChild.Cosmetic = True
                grfChild.Vertices.Add x1, y1, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx1, yy1, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx2, yy2, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add x1, y1, 0#, True, False, False, False, False, False
                grfChild.Closed = True
                grfChild.BrushStyle = "Solid"
                grfChild.Properties.Item("BrushColor").Value = RGB(0, 0, 0)
        End If
  
  Set grfLink0 = Nothing
  Set grfLink1 = Nothing

            'Add visible child Graphics
        End If
      

        grfThis1.RegenUnlock
        Exit Function

        
Failed:
End Function

Public Function Draw(ByVal grfThis1 As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
    
End Function

Private Function Sign(x As Double) As Integer
    If Abs(x) < 0.00001 Then Sign = 0
    If x > 0 Then Sign = 1
    If x < 0 Then Sign = -1
    
End Function

